perm filename CLEFS.F4[MSS,LCS] blob
sn#128700 filedate 1974-11-02 generic text, type T, neo UTF8
00100 C**** CLEFS, JDRAW, CENTR, LINX, UNPACK, ROFF *********
00200 SUBROUTINE CLEFS
00400 DIMENSION JCLEF(11),MCLEF(700),RCMIN(4),KCLEF(11),NCLEF(350)
00600 COMMON /STF/RSTFAC(8),RSTJC /PLTR/IPLT,RHT,DIS
00700 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
00800 DATA RCMIN/3.3,10.5,7.0,10.5/
00900 EQUIVALENCE (JD,JQ(2)),(RJD,RJQ(2)),(JE,JQ(3)),(JI,JQ(7)),(KK,
01000 1 KCLEF(11)),(RJF,RJQ(4)),(RJE,RJQ(3)),(JH,JQ(6)),(RJG,RJQ(5))
01100 1,(RJI,RJQ(7)),(NJR,RJQ(8)),(K,JCLEF(11)),(NCLEF,MCLEF(351))
01200 JE=MOD(JE,100)
01300 CC JEZ=JE
01320 CALL NOZERO(RJF)
01346 IF(RJG.EQ.0)RJG=RJF
01372 C IF P7 = 0, IT WILL EQUAL P6.
01400 IF(JA.GT.10)GO TO 9
01500 NAME='CLEF0'
01600 IF(JE.LT.10)GO TO 4
01700 RJF=RJF*.3
01800 C SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
01900 RJG=RJG*.3
02000 GO TO 4
02100 9 IF(NAME.EQ.NJR)GO TO 4
02200 IF(NAME.NE.0.AND.NJR.EQ.0)GO TO 4
02300 IF(NJR.EQ.0)GO TO 8
02400 C TO PICK UP BASIC DRAW NAME FROM P10
02500 NAME=NJR
02600 GO TO 4
02700 8 TYPE 5
02900 5 FORMAT(' SET P10=1'/)
03200 C LEADS TO PROPER FILE CALL
03300 4 NM=NAME+2*(JE/10)
03400 C DRAW0 HAS ITEMS 0→9; DRAW1, 10→19; ETC. TO DRAW9, 90→99
03500 JEZ=MOD(JE,10)+1
03800 2 IF(NM.EQ.JNM.OR.NM.EQ.KNM)GO TO 30
03900 C SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
04000 C JUMP IF ALREADY IN CORE
04100 IF(LOOKF(NM))GO TO 1111
04200 TYPE 1112,NM
04300 RETURN
04400 1112 FORMAT(1XA5,' -- NOT FOUND')
04405 1111 CALL GETFI2(NM)
04410 IF(KX)GO TO 33
04420 KX=-1
04430 JNM=NM
04600 CC CALL RDDATA(NM,JCLEF,MCLEF)
04700 CC CALL IFILE(23,NM)
04900 CC READ (23)JCLEF,K,(MCLEF(L),L=1,K)
05000 CALL FASTI2(JCLEF,11)
05100 CALL FASTI2(MCLEF,K)
05200 C NEW DATA READER 6/74 -- 10/74 HOLDS 2 .DMD FILES IF THEY FIT.
05210 IF(K.LE.350)GO TO 30
05220 KX=0
05230 KNM=0
05240 GO TO 30
05250 33 CALL FASTI2(KCLEF,11)
05260 KX=0
05270 IF(KK.GT.350)GO TO 1111
05280 C JUMP BACK IF IT WON'T FIT.
05290 CALL FASTI2(NCLEF,KK)
05295 KNM=NM
05300 30 CALL CENTER(CENTR)
05400 C CHECK THE ABOVE -- FOR P5 HEIGHT CHANGE *********************
05800 C RJF IS SIZE FACTOR
05900 IF(JE.GT.3.OR.JA.NE.3)GO TO 811
06050 C 0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
06100 IF(RJE.LT.100)GO TO 812
06200 RSTJC=.8*RSTJC
06300 CENTR=CENTR+RCMIN(JEZ)*RSTJC
06400 C TO SET HGT. OF MINI CLEFS
06500 812 IF(JEZ.NE.4)GO TO 811
06600 CENTR=CENTR+RSTJC*14
06700 JEZ=3
06800 C ABOVE IS NOW AT TOP
06900 811 L=JCLEF(JEZ)
06910 IF(NM.EQ.KNM)L=KCLEF(JEZ)+350
07000 IF(JI.EQ.0)GO TO 31
07050 CALL ROTATE(MCLEF,L)
07060 C RJI=P9=DEGREES OF ROTATION (0-360)
07075 IF(KK.GT.250)KX=0
07175 C CHECK TO SEE IF DATA WAS WIPED OUT.
08110 31 IF(JH.EQ.-2.OR.(JH.NE.-1.AND.IPLT.GE.0))GO TO 32
08120 C JH=-2 OMITS FILLER DURING PLOT
08200 DO 3 K=L+1,MCLEF(L)+L
08300 IF(MCLEF(K).LT.200000000)GO TO 3
08400 JD=MCLEF(L)-1
08500 IF(K.GT.L+1)JD=JD-K+L+1
08600 CALL FILLMS(JD,MCLEF(K),RJB,CENTR,RJF,RJG)
08620 32 CALL JDRAW(MCLEF(L),RJB,CENTR,RSTJC,RJF,RJG)
08640 C 3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, JH=-1 TO FILL ON CRT
08680
08700 RETURN
08800 3 CONTINUE
08900 C FILLS ONLY WHEN PLOTING OR RJG=-1
09000 END
09100
09200 SUBROUTINE JDRAW(M,RJB,CENTR,RSTJC,RX,RY)
09300 COMMON/LL/LL
09400 DIMENSION M(1)
09500 RC=RX*RSTJC
09600 RD=RY*RSTJC
09700 DO 2 K=2,M(1)
09800 CALL UNPACK(IA,IB,M(K))
10300 2 CALL LINES(FLOAT(IA)*RC+RJB,FLOAT(IB)*RD+CENTR,LL)
10400 END
10500
10600 SUBROUTINE CENTER(CNTR)
10700 C TO CENTER ITEMS CREATED WITH DRAWING PROG.
10800 COMMON /STF/RSTFAC(8),RSTJC
10900 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
11000 COMMON/POSI/STF(8),JJB,POS
11100 EQUIVALENCE (RJD,RJQ(2))
11200 CNTR=POS+(2+AMOD(RJD,100.)*7)*RSTJC
11300 END
11400
11500 SUBROUTINE LINX(A,B,C,D)
11600 C SAVES SPACE FOR SINGLE LINES.
11700 CALL LINES(A,B,3)
11800 CALL LINES(C,D,2)
11900 END
12000
12100 SUBROUTINE UNPACK(M,N,I)
12200 COMMON/LL/L
12300 C L IS FOR VIS. OR INVIS. LINES.
12400 N=I
12500 L=2
12600 M=N/100000000
12700 IF(M.EQ.0)GO TO 2
12800 L=3
12900 N=N-100000000*M
13000 2 M=N/10000
13200 N=MOD(N,10000)
13300 IF(M.GT.1000)M=1000-M
13400 IF(N.GT.1000)N=1000-N
13500 END
13600
13700 FUNCTION ROFF(R)
13800 S=.5
13900 IF(R)S=-S
14000 ROFF=R+S
14100 RETURN
14200 END